COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file
C00003 00003	.hd206 SPRING 1978
C00007 00004	.LSPFONT
C00008 00005	.cb |Functions definitions (external and internal form) for assignment 1.|
C00015 ENDMK
C⊗;
.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file;
.PAGE FRAME 56 HIGH 80 WIDE;
.evenleftborder ← oddleftborder ← 1000;
.area text lines 1 to 56;
.place text;
.
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.SKIP  
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TERM
.TURNOFF
.END ⊃
.
.
.MACRO hw (NUMBER, DUEDATE) ⊂
.   BEGIN TURNON "←"  NOFILL
←PROBLEM SET  NUMBER
←Due  DUEDATE
.   TURNOFF END ⊃
.
.itemmac
.
.PORTION MAINPORTION
.
.hd206 SPRING 1978
.skip
.hw 1, |April 18|

	Write LISP programs for each of the functions described below.
For each program turn in the following:
.item←0
.begin nofill indent 12,12

	#.  The internal form of the program.
	#.  The corresponding external form recursive definition.
	#.  A description of how the progam works and why.
	#.  Output from test runs on a variety of input.
.end		
	Late assignments are discouraged and will not be accepted after the 
solutions appear.
.bb Function descriptions.
.item ← 0
.BEGIN INDENT 0,6

#. ⊗allsub[u,v] returns a list giving all occurrences of the list ⊗u 
as a toplevel sublist of ⊗v. An occurrence is given by the number
denoting the position in ⊗v where the match begins.
Thus  ⊗⊗⊗allsub[$$(A A),(A A A A A)$] = $$(1 2 3 4)$.⊗

#. ⊗allsub![u,v] returns a list giving all occurrences of the list ⊗u 
as a sublist of ⊗v, at any level.  Now an occurrence is a list of numbers
giving the path to beginning to sublist occurrence. 
Thus  ⊗⊗⊗allsub![$$(A),(A (B (A (B (A)))))$] = $$((1) (2 2 1) (2 2 2 2 1))$⊗

#.  ⊗mapexp takes as arguments an S-expression, a unary
function ⊗f1 and a binary function ⊗f2.  It takes the S-expression apart,
applies the unary function to each atom and puts the result back 
together using the binary function. 
Thus if ⊗f1 is the identity function and ⊗f2 is ⊗cons then ⊗maptree returns
a copy of the S-expression.  If ⊗f1 is ⊗ncons (forms a list of one element)
and ⊗f2 is ⊗append then ⊗maptree returns the ⊗fringe of the S-expression.

#.  Let a graph ⊗g be represented as described in Chapter I of the text
and suppose that whenever there is an edge from ⊗x to ⊗y  there is also 
an edge from ⊗y to ⊗x.  A component of the graph is a collection of 
vertices which are all connected to each other by edge paths but not 
connected to any vertices not in this collection.  Write a function
⊗ncomps to determine the number of components of a graph ⊗g.  

#. ⊗partition[u,n] is the list of partitions of the list ⊗u into
⊗n sublists ⊗u1, ... ⊗un such that ⊗⊗u1*[u2*...*un]=u⊗.  
If ⊗n is greater than the length of ⊗u then your program should return
an error message of some kind.
Thus 

⊗⊗⊗partition[$$(A B C),2$]=$$((A) (B C))((A B) (C)))$⊗

Write a program ⊗testpart to test the result returned by ⊗partition.  
For each partition, ⊗testpart should append together the lists ⊗ui 
and check that the result is ⊗u.  

.END

.LSPFONT
.basicops 
.next page
.cb |Functions definitions (external and internal form) for assignment 1.|
.item ← 0

#. ⊗allsub[u,v]  
.begin  nofill select 2 

⊗⊗        allsub[u, v] ← allsub1[u, v, 1]⊗

⊗⊗        allsub1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen n . allsub1[u, qd v, add1 n]⊗
⊗⊗            qelse allsub1[u, qd v, add1 n]⊗

⊗⊗        match[u, v] ← ⊗
⊗⊗            qif qn u qthen qT qelse qif qn v qthen qNIL qelse qa u = qa v ∧ match[qd u, qd v]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB (U V) (ALLSUB1 U V 1.)) 

	(DEFUN ALLSUB1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V) (CONS N (ALLSUB1 U (CDR V) (ADD1 N))))
		     (T (ALLSUB1 U (CDR V) (ADD1 N))))) 

	(DEFUN MATCH (U V) 
	       (COND ((NULL U) T)
		     ((NULL V) NIL)
		     (T (AND (EQUAL (CAR U) (CAR V))
			     (MATCH (CDR U) (CDR V)))))) 
.end

#. ⊗allsub![u,v] 

.begin nofill select 2

⊗⊗        allsub![u, v] ← allsub!1[u, v, 1]⊗

⊗⊗        allsub!1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen <n> . allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse qif qat qa v qthen allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse tack[n, allsub![u, qa v]] * allsub!1[u, qd v, add1 n]⊗

⊗⊗        tack[n, w] ← qif qn w qthen qNIL qelse [n . qa w] . tack[n, qd w]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB! (U V) (ALLSUB!1 U V 1.)) 

	(DEFUN ALLSUB!1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V)
		      (CONS (LIST N) (ALLSUB!1 U (CDR V) (ADD1 N))))
		     ((ATOM (CAR V)) (ALLSUB!1 U (CDR V) (ADD1 N)))
		     (T (APPEND (TACK N (ALLSUB! U (CAR V)))
				(ALLSUB!1 U (CDR V) (ADD1 N)))))) 

	(DEFUN TACK (N W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))))) 
.end

#.  ⊗mapexp [or ⊗⊗maptree⊗]

.begin nofill select 2

⊗⊗        maptree[s, f1, f2] ← ⊗
⊗⊗            qif qat s qthen f1 s⊗
⊗⊗            qelse f2[maptree[qa s, f1, f2], maptree[qd s, f1, f2]]⊗
.end
.begin nofill select 6

	(DEFUN MAPTREE (S F1 F2) 
	       (COND ((ATOM S) (F1 S))
		     (T (F2 (MAPTREE (CAR S) F1 F2)
			    (MAPTREE (CDR S) F1 F2))))) 
.end

#. ⊗ncomps 
.begin nofill select 2

⊗⊗        ncomps g ← qif qn g qthen 0 qelse add1 ncomps scan[qd g, qNIL, qa g, qNIL]⊗

⊗⊗        scan[g, h, u, flag] ← ⊗
⊗⊗            qif qn g qthen [qif qn flag ∨ qn h qthen h qelse scan[h, qNIL, u, qNIL]]⊗
⊗⊗            qelse qif qn [qaa g ε u] qthen scan[qd g, qa g . h, u, flag]⊗
⊗⊗            qelse scan[qd g, h, u * qa g, qT]⊗
.end


.begin nofill select 6

(DEFUN NCOMPS (G) 
       (COND ((NULL G) 0.)
	     (T (ADD1 (NCOMPS (SCAN (CDR G) NIL (CAR G) NIL)))))) 

(DEFUN SCAN (G H U FLAG) 
       (COND ((NULL G)
	      (COND ((OR (NULL FLAG) (NULL H)) H)
		    (T (SCAN H NIL U NIL))))
	     ((NULL (MEMBER (CAAR G) U))
	      (SCAN (CDR G) (CONS (CAR G) H) U FLAG))
	     (T (SCAN (CDR G) H (APPEND U (CAR G)) T)))) 	       
.end

#. ⊗partition[u,n] 
.begin nofill select 2

⊗⊗        partition[u, n] ← ⊗
⊗⊗            qif length u < n qthen $$(INVALID N)$ qelse part1[<qa u>, qd u, sub1 n]⊗

⊗⊗        part1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen [qif zerop n qthen <<u>> qelse qNIL]⊗
⊗⊗            qelse tack[u, part1[<qa v>, qd v, sub1 n]]⊗
⊗⊗                  * part1[u * <qa v>, qd v, n]⊗

⊗⊗        testpart[v, u] ← ⊗
⊗⊗            qif qn v qthen qT⊗
⊗⊗            qelse combine qa v = u ∧ testpart[qd v, u] ⊗

⊗⊗        combine w ← qif qn w qthen qNIL qelse qa w * combine qd w⊗
.end

.begin nofill select 6

	(DEFUN PARTITION (U N) 
	       (COND ((LESSP (LENGTH U) N) '(INVALID N))
		     (T (PART1 (LIST (CAR U)) (CDR U) (SUB1 N))))) 

	(DEFUN PART1 (U V N) 
	       (COND ((NULL V) (COND ((ZEROP N) (LIST (LIST U))) (T NIL)))
		     (T (APPEND (TACK U
				      (PART1 (LIST (CAR V)) (CDR V) (SUB1 N)))
				(PART1 (APPEND U (LIST (CAR V)))
				       (CDR V)
				       N))))) 

	(DEFUN LINK (U W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS U (CAR W)) (LINK U (CDR W)))))) 

	(DEFUN TESTPART (V U) 
	       (COND ((NULL V) T)
		     ((AND (EQUAL (COMBINE (CAR V)) U)
			   (TESTPART (CDR V) U))))) 

	(DEFUN COMBINE (W) 
	       (COND ((NULL W) NIL) (T (APPEND (CAR W) (COMBINE (CDR W)))))) 
.end